home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / main.c < prev    next >
C/C++ Source or Header  |  1992-11-10  |  30KB  |  1,302 lines
  1. /* ******************************************************************** */
  2. /*  main.c           Copyright (C) Codemist and University of Bath 1989 */
  3. /*                                                                      */
  4. /* User top level                                            */
  5. /* ******************************************************************** */
  6.  
  7. /*
  8.  * $Id: main.c,v 1.23 1992/10/26 15:34:56 djb Exp pab $
  9.  *
  10.  * $Log: main.c,v $
  11.  * Revision 1.23  1992/10/26  15:34:56  djb
  12.  * DGC changes
  13.  *
  14.  * Revision 1.22  1992/06/18  10:01:24  pab
  15.  * improved includes, decls
  16.  *
  17.  * Revision 1.21  1992/06/16  19:38:08  pab
  18.  * feelrc mods
  19.  *
  20.  * Revision 1.20  1992/06/09  14:03:59  pab
  21.  * more BCI paranoia
  22.  *
  23.  * Revision 1.19  1992/05/28  17:04:32  rjb
  24.  * a NULL -> 0
  25.  *
  26.  * Revision 1.18  1992/05/26  11:28:03  pab
  27.  * map option added
  28.  *
  29.  * Revision 1.17  1992/05/19  11:19:22  pab
  30.  * -boot option
  31.  *
  32.  * Revision 1.16  1992/04/26  21:02:27  pab
  33.  * symbol fixes
  34.  *
  35.  * Revision 1.15  1992/03/13  18:08:06  pab
  36.  * SysV fixes (interpreter thread sort out)
  37.  *
  38.  * Revision 1.14  1992/02/18  11:16:06  pab
  39.  * added handler
  40.  *
  41.  * Revision 1.13  1992/02/11  13:38:32  pab
  42.  * fixed generic version
  43.  *
  44.  * Revision 1.12  1992/02/11  12:06:05  pab
  45.  * handler around load of initcode
  46.  *
  47.  * Revision 1.11  1992/02/10  12:07:02  pab
  48.  * Bytecode support
  49.  *
  50.  * Revision 1.10  1992/01/29  13:42:12  pab
  51.  * sysV fixes
  52.  *
  53.  * Revision 1.9  1992/01/17  22:31:19  pab
  54.  * fixed to load initcode at startup
  55.  *
  56.  * Revision 1.7  1992/01/09  22:28:53  pab
  57.  * Fixed for low tag ints
  58.  *
  59.  * Revision 1.6  1991/12/22  15:14:18  pab
  60.  * Xmas revision
  61.  *
  62.  * Revision 1.5  1991/11/15  13:45:08  pab
  63.  * copyalloc rev 0.01
  64.  *
  65.  * Revision 1.4  1991/10/08  19:27:42  pab
  66.  * arg to init_elvira changed
  67.  *
  68.  * Revision 1.3  1991/09/22  19:14:37  pab
  69.  * Fixed obvious bugs
  70.  *
  71.  * Revision 1.2  1991/09/11  12:07:24  pab
  72.  * 11/9/91 First Alpha release of modified system
  73.  *
  74.  * Revision 1.1  1991/08/12  16:49:47  pab
  75.  * Initial revision
  76.  *
  77.  * Revision 1.18  1991/04/03  21:06:36  kjp
  78.  * -cons-cut-off option
  79.  *
  80.  * Revision 1.17  1991/04/03  16:28:06  kjp
  81.  * History modifications - incomplete
  82.  *
  83.  * Revision 1.16  1991/04/02  16:41:32  kjp
  84.  * Conses command line option.
  85.  *
  86.  * Revision 1.15  1991/02/28  14:00:52  kjp
  87.  * Command line stack-space option.
  88.  *
  89.  * Revision 1.14  1991/02/13  18:23:09  kjp
  90.  * Pass.
  91.  *
  92.  */
  93.  
  94. #define JMPDBG(x)
  95. #define CODBG(x) /* fprintf(stderr,"CODBG:");x;fflush(stderr) */
  96.  
  97. /*
  98.  * Change Log:
  99.  *   Version 1, April 1989
  100.  *     Read a .feelrc file if it exists - JPff
  101.  *    Various changes for streams
  102.  *    Remove Env argument from make_module_function and make_special 
  103.  *        as always NULL
  104.  *    Initialise threads.
  105.  *      Added a one result history and fiddled with some object definitions.
  106.  */
  107.  
  108. #include "version.h"
  109.  
  110. #include "defs.h"
  111. #include "structs.h"
  112. #include "funcalls.h"
  113.  
  114. #include "error.h"
  115. #include "global.h"
  116. #include "slots.h"
  117. /*#include "compact.h" */
  118. #include "garbage.h" /* What do I need this for */
  119.  
  120. #include "symboot.h"
  121. #include "modules.h"
  122. #include "toplevel.h"
  123. #include "root.h"
  124. #include "specials.h"
  125. #include "lists.h"
  126. #include "listops.h"
  127. #include "calls.h"
  128. #include "ccc.h"
  129. #include "allocate.h"
  130.  
  131. #include "modboot.h"
  132.  
  133. #include "state.h"
  134. #include "macros.h"
  135. #include "semaphores.h"
  136. #include "format.h"
  137. #include "modops.h"
  138. #include "threads.h"
  139. #include "sio.h"
  140.  
  141. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  142. #include "sockets.h"
  143. #endif
  144.  
  145. #ifdef BCI
  146. #include "bvf.h"
  147. #endif
  148.  
  149. /*
  150.  * Hack number 1A - push everything as yet unmodulised into OTHER
  151.  */
  152.  
  153. #ifdef WITH_SYS_TIMES
  154. #define OTHER_ENTRIES 25
  155. #else
  156. #define OTHER_ENTRIES 24
  157. #endif
  158.  
  159. MODULE Module_others;
  160. LispObject Module_others_values[OTHER_ENTRIES];
  161.  
  162. /*
  163.  * The provided classes / constants / symbols
  164.  */
  165.  
  166. /* Built in constants */
  167.  
  168. LispObject nil;
  169. LispObject lisptrue;
  170. LispObject unbound;
  171.  
  172. /* Root class */
  173.  
  174. LispObject Object;
  175.  
  176. /* Meta classes */
  177.  
  178. LispObject  Standard_Class;
  179. LispObject   Slot_Description_Class;
  180.  
  181. LispObject Abstract_Class;
  182.  
  183. LispObject Slot_Description;
  184. LispObject  Local_Slot_Description;
  185.  
  186. LispObject Basic_Structure;
  187.  
  188. /* Allocation specifying metaclasses */
  189.  
  190. LispObject Structure_Class;                /* Analogous to C structs */
  191. LispObject Funcallable_Object_Class;       /* Function forms */
  192. LispObject Generic_Class;
  193. LispObject Pair_Class;
  194. LispObject Unpredictable_Fixed_Size_Class; /* Vector-type things */
  195. LispObject Variable_Size_Keyed_Class;      /* Tabular instances */
  196. LispObject Thread_Class;
  197. LispObject Method_Class;
  198.  
  199. /* Built in stuff */
  200.  
  201. LispObject Primitive_Class; 
  202.  
  203. /* The core building blocks */
  204.  
  205. LispObject Abstract_Class; /* Meta */
  206. LispObject Number, Complex, Real, Rational, Integer;
  207. LispObject Symbol, Character, String;
  208. LispObject Thread, Continue;
  209. LispObject Function, Generic, Method, Macro;
  210.  
  211. /* Composites */
  212.  
  213. LispObject Cons, Vector, Table, Null; /* Empty list... */
  214.  
  215. /* Special pointer */
  216.  
  217. LispObject Weak_Wrapper;
  218.  
  219. /* Flag thing */
  220.  
  221. LispObject last_evaluated_expression;         /* Input help */
  222. LispObject top_level(LispObject*);
  223. extern FILE* current_output;
  224.  
  225. static char *command_line_boot_file;
  226.  
  227. /* Quick way of making self evaluating sybols */
  228.  
  229. void make_special_symbol(LispObject *stacktop, LispObject *objptr, char *name )
  230. {
  231.   *objptr = (LispObject) get_symbol(stacktop, name );
  232.   lval_typeof(*objptr) = TYPE_SYMBOL;
  233. #ifndef DGC
  234.   gcof((*objptr))   = 0;
  235. #endif
  236.   ((*objptr)->SYMBOL).right = NULL;
  237. }
  238.  
  239. /* Top level thread holder... */
  240.  
  241. LispObject interpreter_thread;
  242.  
  243. /* Temporary-ish jump buffer... */
  244.  
  245. LispObject tl_thread;
  246.  
  247. jmp_buf temp_buffer;
  248.  
  249. extern LispObject read_eval_print_continue;
  250. LispObject boot_thread;
  251.  
  252. int main(int argc, char ** argv)
  253. {
  254.   void load_and_boot(LispObject *);
  255.   extern void runtime_initialise_allocator(LispObject*);
  256.   void configure(int,char **);
  257.   void start_interpreter(LispObject*);
  258.  
  259.   LispObject *gc_local_stack;
  260.  
  261.   configure(argc,argv);
  262.  
  263.   /*
  264.  
  265.    * System initialisation...
  266.  
  267.    */
  268.  
  269.   runtime_initialise_system();     /* Rig system spec stuff */
  270.   runtime_initialise_allocator(NULL);  
  271.   runtime_initialise_garbage_collector(NULL);
  272.  
  273. #ifdef WITH_BYTECODE
  274. /* Initialize bytecode interpreter stack */
  275.  
  276.   init_stack();
  277. #endif
  278.  
  279.   OFF_collect();
  280.  
  281.   /*
  282.  
  283.    * We gotta rig up something so that we can use a few basic system
  284.    * functions during the main bootstrap sequence - this implies
  285.    * just setting up what will become the interpreter thread enough
  286.    * to get us moving...
  287.  
  288.    */
  289.  
  290.   /*
  291.  
  292.    * Set up preliminary thread stuff...
  293.  
  294.    */
  295.  
  296.   /* Interpreter GC stack (nominal, for bootstrapping)... */
  297.  
  298.   gc_local_stack = (LispObject*) malloc(4096*sizeof(LispObject*));
  299.   if (gc_local_stack ==  NULL) {
  300.     fprintf(stderr,"Really nasty error: unable to malloc gc_local_stack\n");
  301.     exit(1);
  302.   }
  303.  
  304.   fprintf(stderr,"stack: 0x%x Lim: 0x%x\n",
  305.       gc_local_stack,
  306.       gc_local_stack + 4096);
  307.   /* Allocate the top level thread... */
  308.  
  309.   nil = NULL;
  310.   Thread = NULL;
  311.  
  312.   boot_thread 
  313.     = allocate_thread(gc_local_stack,0,0,0);
  314.  
  315.   /* Fill in as best we can... */
  316.  
  317.   boot_thread->THREAD.stack_base = NULL;
  318.   boot_thread->THREAD.gc_stack_base = gc_local_stack;
  319.   boot_thread->THREAD.state->CONTINUE.gc_stack_pointer = gc_local_stack;
  320.  
  321.   boot_thread->THREAD.stack_base = NULL;
  322.   boot_thread->THREAD.gc_stack_base = gc_local_stack;
  323.  
  324.   boot_thread->THREAD.stack_size = 0xffffffff; /* lots'n'lots */
  325.   boot_thread->THREAD.gc_stack_size = 100*HUNK_PAGE_SIZE()*sizeof(LispObject*);
  326.  
  327.   boot_thread->THREAD.fun = nil;
  328.   boot_thread->THREAD.args = nil;
  329.   boot_thread->THREAD.value = nil;
  330.   
  331.   boot_thread->THREAD.status = 0;
  332.  
  333.   boot_thread->THREAD.parent = nil;
  334.   boot_thread->THREAD.cochain = nil;
  335.  
  336.   /* Thread continuation... */
  337.  
  338.   boot_thread->THREAD.state->CONTINUE.thread = boot_thread;
  339.  
  340.   boot_thread->THREAD.state->CONTINUE.value = nil;
  341.   boot_thread->THREAD.state->CONTINUE.target = nil;
  342.  
  343. /*  boot_thread->THREAD.state.machine_state; */
  344.   boot_thread->THREAD.state->CONTINUE.gc_stack_pointer = gc_local_stack;
  345.   boot_thread->THREAD.state->CONTINUE.dynamic_env = NULL;
  346.   boot_thread->THREAD.state->CONTINUE.last_continue = nil;
  347.   boot_thread->THREAD.state->CONTINUE.handler_stack = nil;
  348.  
  349.   boot_thread->THREAD.state->CONTINUE.live = FALSE;
  350.   boot_thread->THREAD.state->CONTINUE.unwind = FALSE;
  351.  
  352.   /*
  353.  
  354.    * We have a 'serviceable' thread - initialise the system specific
  355.    * bits for serial initialisation...
  356.  
  357.    */
  358.   { 
  359.     LispObject *stacktop;
  360.     
  361.     stacktop = load_thread(boot_thread); /* Context to this thread... */
  362.     add_root(&boot_thread);
  363.     load_and_boot(stacktop);          /* Do module boot sequence... */
  364.     
  365.     interpreter_thread=EUCALL_2(Fn_cons,nil,nil);
  366.     read_eval_print_continue=EUCALL_2(Fn_cons,nil,nil);
  367.     tl_thread=EUCALL_2(Fn_cons,nil,nil);
  368.  
  369.     add_root(&interpreter_thread);
  370.     add_root(&read_eval_print_continue);
  371.     add_root(&tl_thread);
  372.  
  373.     start_interpreter(stacktop);      /* Start the interpreter... */
  374.   }
  375. }
  376.  
  377. #define INTERPRETER_THREAD_STACK_SIZE  (64*1024*1)
  378. #define INTERPRETER_THREAD_GC_STACK_SIZE  (32*1024*1)
  379.  
  380.  
  381. #ifndef MACHINE_ANY
  382.  
  383. void start_interpreter(LispObject *stacktop)
  384. {
  385.   extern LispObject Fn_thread_start(LispObject*);
  386.   void start_history(void);
  387.  
  388.   LispObject function_read_eval_print;
  389.  
  390.   CAR(interpreter_thread) 
  391.     = allocate_thread(stacktop, INTERPRETER_THREAD_STACK_SIZE,
  392.               INTERPRETER_THREAD_GC_STACK_SIZE,0);
  393.  
  394.   function_read_eval_print =
  395.     allocate_module_function(stacktop, nil,nil,top_level,0);
  396.  
  397.   CAR(interpreter_thread)->THREAD.fun = function_read_eval_print;
  398.   CAR(interpreter_thread)->THREAD.status = THREAD_LIMBO;
  399.   system_thread_rig(stacktop,CAR(interpreter_thread));
  400.  
  401.   /* Install as ready... */
  402.  
  403.   EUCALL_2(Fn_thread_start,CAR(interpreter_thread),nil);
  404.  
  405.   CAR(read_eval_print_continue) = allocate_continue(stacktop);
  406. #ifndef KJP
  407.   start_history();
  408. #endif
  409.  
  410.   /* Store as the top level thread... */
  411.   
  412.   tl_thread = CAR(interpreter_thread);
  413.  
  414.   /* Name and configuration... */
  415.  
  416.   printf("EuLISP FEEL: Version (%d.%.02d ",MAJOR_VERSION,MINOR_VERSION);
  417.  
  418. #ifdef KJP
  419.  
  420. #ifdef MACHINE_SYSTEMV
  421.   printf("KJP-SystemV)");
  422. #endif
  423. #ifdef MACHINE_BSD
  424.   printf("KJP-BSD)");
  425. #endif
  426. #ifdef MACHINE_ANY
  427.   printf("KJP-Generic)");
  428. #endif
  429. #ifdef FIX_LEVEL
  430.   printf(" (fix %d)",FIX_LEVEL);
  431. #endif
  432.  
  433. #else /* KJP */
  434.  
  435. #ifdef MACHINE_SYSTEMV
  436.   printf("SystemV)");
  437. #endif
  438. #ifdef MACHINE_BSD
  439.   printf("BSD)");
  440. #endif
  441. #ifdef MACHINE_ANY
  442.   printf("Generic)");
  443. #endif
  444. #ifdef FIX_LEVEL
  445.   printf(" (fix %d)",FIX_LEVEL);
  446. #endif
  447.  
  448. #endif /* KJP */
  449.  
  450.   printf(" %s\n",MAKE_DATE);
  451.   printf("\n");
  452.  
  453. #ifdef VERSION_MESSAGE
  454.   printf("                    Version Message\n\n");
  455.   printf(VERSION_MESSAGE);
  456.   printf("\n");
  457. #endif
  458.  
  459.   fflush(stdout);
  460.   ON_collect();
  461.   
  462.   {LispObject xx;
  463.  
  464.    xx=boot_thread;
  465.    boot_thread=nil;
  466.    runtime_begin_processes(xx->THREAD.state->CONTINUE.gc_stack_pointer);
  467.  }
  468. }
  469.  
  470. #else
  471.  
  472. void start_interpreter(LispObject *stacktop)
  473. {
  474.   void start_history(void);
  475.  
  476.   /* Generate the interpreter thread... */
  477.  
  478.   CAR(interpreter_thread )
  479.     = allocate_thread(stacktop, 0,INTERPRETER_THREAD_GC_STACK_SIZE,0);
  480.   CAR(interpreter_thread)->THREAD.fun = nil;
  481.   CAR(interpreter_thread)->THREAD.status = THREAD_RUNNING;
  482.  
  483.   CAR(read_eval_print_continue) = allocate_continue(stacktop);
  484.  
  485. #ifndef KJP
  486.   start_history();
  487. #endif
  488.  
  489.   /* Store as the top level thread... */
  490.  
  491.   CAR(tl_thread) = CAR(interpreter_thread);
  492.   /* Name and configuration... */
  493.   ON_collect();
  494.  
  495.   printf("EuLISP FEEL: Version (%d.%.02d ",MAJOR_VERSION,MINOR_VERSION);
  496.  
  497. #ifdef KJP
  498.  
  499. #ifdef MACHINE_SYSTEMV
  500.   printf("KJP-SystemV)");
  501. #endif
  502. #ifdef MACHINE_BSD
  503.   printf("KJP-BSD)");
  504. #endif
  505. #ifdef MACHINE_ANY
  506.   printf("KJP-Generic)");
  507. #endif
  508. #ifdef FIX_LEVEL
  509.   printf(" (fix %d)",FIX_LEVEL);
  510. #endif
  511.  
  512. #else /* KJP */
  513.  
  514. #ifdef MACHINE_SYSTEMV
  515.   printf("SystemV)");
  516. #endif
  517. #ifdef MACHINE_BSD
  518.   printf("BSD)");
  519. #endif
  520. #ifdef MACHINE_ANY
  521.   printf("Generic)");
  522. #endif
  523. #ifdef FIX_LEVEL
  524.   printf(" (fix %d)",FIX_LEVEL);
  525. #endif
  526.  
  527. #endif /* KJP */
  528.  
  529.   printf(" %s\n",MAKE_DATE);
  530.   printf("\n");
  531.  
  532. #ifdef VERSION_MESSAGE
  533.   printf("                    Version Message\n\n");
  534.   printf(VERSION_MESSAGE);
  535.   printf("\n");
  536. #endif
  537.  
  538.   fflush(stdout);
  539.  
  540.   stacktop = load_thread(CAR(tl_thread)); /* So repl continue has the right thread base */
  541.   ON_collect();
  542.   (void) top_level(stacktop);
  543. }
  544.  
  545. #endif
  546.  
  547. void load_and_boot(LispObject *stacktop)
  548. {
  549.   extern MODULE Module_generics;
  550.   extern int gc_enabled;
  551.   extern void initialise_elvira_modules(LispObject *);
  552.  
  553.   bootstrap(stacktop); /* Bootstrap classes and some special symbols */
  554.   initialise_modules(stacktop);
  555.   initialise_symbols(stacktop); /* Rig up the others */
  556.   initialise_specials(stacktop);
  557.   initialise_root(stacktop);
  558.  
  559.   /* Hacked history */
  560.  
  561.   make_special_symbol(stacktop, &last_evaluated_expression, ":last" );
  562.  
  563.   /* Open up the other module and do the rest */
  564.  
  565.   open_module(stacktop,
  566.           &Module_others,Module_others_values,"others",OTHER_ENTRIES);
  567.  
  568.   initialise_set(stacktop);
  569.   initialise_basic(stacktop);
  570.   initialise_garbage(stacktop);
  571.   initialise_macros(stacktop);
  572.  
  573.   close_module();    
  574.   lval_typeof((LispObject)&Module_generics)=TYPE_C_MODULE;
  575.   
  576.   /* Initialise the modular sections */
  577.  
  578.   initialise_error(stacktop);
  579.   initialise_classes(stacktop);
  580.   initialise_streams(stacktop);
  581.   initialise_generics(stacktop);
  582.   initialise_ccc(stacktop);
  583.   initialise_lists(stacktop);
  584.   initialise_listops(stacktop);
  585.   initialise_tables(stacktop);
  586.   initialise_vectors(stacktop);
  587.   initialise_chars(stacktop);
  588.   initialise_calls(stacktop);
  589.   initialise_arith(stacktop);
  590.   initialise_threads(stacktop);
  591.   initialise_semaphores(stacktop);
  592.  
  593.   initialise_formatted_io(stacktop);
  594.   initialise_module_operators(stacktop);
  595.  
  596. #if (defined(WITH_BSD_SOCKETS) || defined(WITH_SYSTEMV_SOCKETS))
  597.   {
  598.     extern void initialise_sockets(LispObject *);
  599.     initialise_sockets(stacktop);
  600.   }
  601. #endif
  602.   initialise_bit_vectors(stacktop);
  603.  
  604. #ifdef WITH_BIGNUMS
  605.   initialise_bignums(stacktop);
  606. #endif
  607.  
  608. #ifdef BCI
  609.   initialise_bci(stacktop);
  610. #endif
  611.   /* Set up Elvira modules... */
  612.  
  613.   /* Note: because these may contain init-errors, we provide a handler */
  614.  
  615.   {
  616.     extern LispObject function_bootstrap_handler;
  617.     LispObject xx;
  618.  
  619.     EUCALLSET_2(xx,Fn_cons,function_bootstrap_handler,nil);
  620.     HANDLER_STACK() =
  621.       CURRENT_THREAD()->THREAD.state->CONTINUE.handler_stack 
  622.     = xx;
  623.   }
  624.  
  625.   initialise_elvira_modules(stacktop);
  626. }
  627.  
  628. LispObject read_eval_print_continue;
  629.  
  630. /* This top-level is the function which is run on the interpreter thread... */
  631.  
  632. int command_line_do_done_flag;
  633. int feelrc_read_flag;
  634.  
  635. LispObject top_level(LispObject *stacktop)
  636. {
  637.   extern char *command_line_do_string;
  638.   extern int command_line_map_flag;
  639.   LispObject get_history_form(LispObject);
  640.   void put_history_form(LispObject *,LispObject);
  641.   int get_history_count(void);
  642.   void initialise_input_processing(void);
  643.   LispObject process_input_form(LispObject);
  644.   LispObject process_result_form(LispObject);
  645.   void make_description_file(LispObject *);
  646.  
  647.   if (command_line_map_flag) make_description_file(stacktop);
  648.  
  649.   CODBG(fprintf(stderr,"Entering toplevel on thread %d\n",THIS_PROCESS));
  650.  
  651.   current_output = (StdOut->STREAM).handle;
  652.   SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  653.     get_module(stacktop,sym_root);
  654.  
  655.   command_line_do_done_flag = FALSE;
  656.   feelrc_read_flag = FALSE;
  657.  
  658. #ifdef KJP
  659.   initialise_input_processing();
  660. #endif
  661.  
  662.   /* Load the initialisation module/bootfile */
  663. #ifdef BCI
  664.   if (command_line_boot_file!=NULL)
  665.     {
  666.       LispObject str;
  667.       str=allocate_string(stacktop,command_line_boot_file,strlen(command_line_boot_file)+1);
  668.       EUCALL_1(Fn_load_bytecodes,str);
  669.     }
  670.   else
  671. #endif
  672.     {
  673.       LispObject sym_init;
  674.       extern LispObject function_bootstrap_handler;
  675.       extern LispObject function_default_handler;
  676.       LispObject xx,oldstack;
  677.  
  678.       sym_init=get_symbol(stacktop,"initcode");
  679.  
  680.       EUCALLSET_2(xx,Fn_cons,function_bootstrap_handler,nil);
  681.       HANDLER_STACK() = xx;
  682.  
  683.       EUCALL_1(load_module,sym_init);
  684.       HANDLER_STACK()=CDR(xx);
  685.  
  686.       EUCALLSET_2(xx,Fn_cons,function_default_handler,nil);
  687.       HANDLER_STACK() = xx;
  688.     
  689.     }
  690.  
  691.  
  692.  reset:
  693.  
  694.   if (set_continue(stacktop,CAR(read_eval_print_continue))) {
  695.  
  696.     if (CAR(read_eval_print_continue)->CONTINUE.value == lisptrue) {
  697.       (void) garbage_collect(stacktop);
  698.       printf("\n");
  699.       fflush(stdout);
  700.     }
  701.  
  702. #ifdef KJP
  703.  
  704.     /* Being here implies that no result was returned from the last 
  705.        expression so we'll add a dummy value to the value history   */
  706.  
  707.  
  708.     (void) process_result_form(nil);
  709. #endif
  710.  
  711.     /* Doc Frankenstein would be proud... */
  712.  
  713.     goto reset;
  714.  
  715.   }
  716.  
  717.   /* If do was configured, fix it... */
  718.  
  719.   if (command_line_do_string != NULL && command_line_do_done_flag == FALSE) {
  720.     LispObject command,ans;
  721.     
  722.     command_line_do_done_flag = TRUE;
  723.  
  724.     BUFFER_PTR() = 0;
  725.     strcpy(BUFFER_START(),command_line_do_string);
  726.  
  727.     fprintf(StdOut->STREAM.handle,"Doing: '%s'\n",BUFFER_START());
  728.  
  729.     command = read_object(stacktop);
  730.  
  731.     fprintf(StdOut->STREAM.handle,"Exp: ");
  732.     EUCALL_2(Fn_print,command,StdOut);
  733.  
  734.     EUCALLSET_2(ans,process_top_level_form,
  735.          SYSTEM_GLOBAL_VALUE(current_interactive_module),
  736.          command);
  737.  
  738.     fprintf(StdOut->STREAM.handle,"Done: ");
  739.     EUCALL_2(Fn_print,ans,StdOut);
  740.     fprintf(StdOut->STREAM.handle,"\n");
  741.   }
  742.  
  743.   /* Load the configuration file... */
  744.  
  745.   if (!feelrc_read_flag) {
  746.     extern char *getenv(char *);
  747.     extern LispObject Fn_close(LispObject*);
  748.     char path[1000];
  749.     FILE *inits;
  750.     LispObject initstr;
  751.     char *home;
  752.  
  753.     feelrc_read_flag = TRUE;
  754.  
  755.     home = getenv("HOME");
  756.     if (home == NULL)    
  757.       path[0]='\0';
  758.     else
  759.       strcpy(path,home);
  760.  
  761.     strcat(path, FEEL_RC_FILE );
  762.     inits = fopen(path,"r");
  763.     if (inits != NULL) {
  764.  
  765.       initstr = allocate_stream(stacktop, inits,'r');
  766.       while (TRUE) {
  767.     LispObject form;
  768.     STACK_TMP(initstr);
  769.     EUCALLSET_1(form, Fn_read, initstr);
  770.     UNSTACK_TMP(initstr);
  771.     if (form == q_eof) break;
  772.     STACK_TMP(initstr);
  773.     EUCALL_2(process_top_level_form,
  774.              SYSTEM_GLOBAL_VALUE(current_interactive_module),
  775.              form);
  776.     UNSTACK_TMP(initstr);
  777.       }
  778.       EUCALL_1(Fn_close, initstr);
  779.     }
  780.   }
  781.  
  782.   while (TRUE) {
  783.     extern char current_prompt_string[];
  784.     extern LispObject Gf_generic_write(LispObject*);
  785.     extern LispObject sym_pling_root;
  786.     extern LispObject sym_pling_exit;
  787.     extern int system_scheduler_number;
  788.     LispObject form, ans;
  789.     FILE *current_output;
  790.  
  791.     current_output = (StdOut->STREAM).handle;
  792.  
  793.     sprintf(current_prompt_string,"eulisp:%x:%s!%d> ",system_scheduler_number,
  794.         stringof(SYSTEM_GLOBAL_VALUE(current_interactive_module)
  795.              ->I_MODULE.name->SYMBOL.pname),
  796.         get_history_count());
  797.  
  798. #ifndef GNUREADLINE
  799.     fprintf(current_output,"%s",current_prompt_string);
  800.     fflush(current_output);
  801. #endif
  802.     EUCALLSET_1(form, Fn_read, nil);
  803. #ifdef KJP
  804.     if ((form = process_input_form(form)) == NULL) break;
  805.     ans 
  806.       = process_top_level_form(SYSTEM_GLOBAL_VALUE(current_interactive_module),
  807.                    form);
  808.     ans = process_result_form(ans);
  809. #else
  810.     form = get_history_form(form); /* never allocs */
  811.     STACK_TMP(form);
  812.     put_history_form(stacktop, form);
  813.     UNSTACK_TMP(form);
  814.     if (form == q_eof || form == sym_pling_exit) break;
  815.     if (form == sym_pling_root) {
  816.       SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  817.     get_module(stacktop,sym_root);
  818.       ans = nil;
  819.     }
  820.     else {
  821.       EUCALLSET_2(ans,process_top_level_form,
  822.           SYSTEM_GLOBAL_VALUE(current_interactive_module),
  823.           form);
  824.  
  825.       last_evaluated_expression = ans;
  826.     }
  827. #endif
  828.  
  829.     current_output = (StdOut->STREAM).handle;
  830.  
  831.     if (GC_STACK_POINTER() != GC_STACK_BASE())
  832.       fprintf(current_output,"GC Error: ptr=%d (recovered)\n",
  833.           GC_STACK_POINTER() - GC_STACK_BASE());
  834.     /** hack **/
  835.     GC_STACK_POINTER() = GC_STACK_BASE();
  836.  
  837.     fprintf(current_output,"eulisp:%x:%s!%d< ",system_scheduler_number,
  838.         stringof(SYSTEM_GLOBAL_VALUE(current_interactive_module)
  839.              ->I_MODULE.name->SYMBOL.pname),
  840.         get_history_count()-1);
  841.  
  842.     EUCALL_2(Gf_generic_write,ans,StdOut);
  843.  
  844.     fprintf(current_output,"\n\n");
  845.     fflush(current_output);
  846.  
  847.   }
  848.  
  849.   fprintf(stderr,"\nEuLISP finishing\n\n");
  850.  
  851.   system_lisp_exit(1);
  852.  
  853.   return nil;
  854.  
  855. }
  856.  
  857. /* 
  858.  
  859.  * Configuration... 
  860.  
  861.  */
  862.  
  863. char *command_line_do_string;
  864. int command_line_window_flag;
  865. int command_line_heap_size;
  866. int command_line_stack_space_size;
  867. int command_line_map_flag;
  868. int command_line_processors;
  869. int command_line_interface_flag;
  870. void configure(int argc,char **argv)
  871. {
  872.   extern int command_line_x_debug;
  873.   int i = 1;
  874.  
  875.   /* Nullify options... */
  876.  
  877.   command_line_do_string = NULL;
  878.   command_line_window_flag = FALSE;
  879.   command_line_heap_size = 0;
  880.   command_line_stack_space_size = 0;
  881.   command_line_map_flag = FALSE;
  882.   command_line_x_debug = FALSE;
  883.   command_line_interface_flag = FALSE;
  884.   command_line_processors = 0;
  885.   command_line_boot_file = NULL;
  886.  
  887.   while (i < argc) {
  888.  
  889.     if (strcmp(argv[i],"-do") == 0) {
  890.       if (argc - i < 2) {
  891.     fprintf(stderr,"eulisp: bad -do option\n");
  892.     exit(1);
  893.       }
  894.       command_line_do_string = argv[i+1];
  895.       i+=2;
  896.       continue;
  897.     }
  898.  
  899.     if (strcmp(argv[i],"-win") == 0) {
  900.       command_line_window_flag = TRUE;
  901.       ++i;
  902.       continue;
  903.     }
  904.  
  905.     if (strcmp(argv[i],"-xdebug") == 0 
  906.     || strcmp(argv[i],"-Xdebug") == 0) {
  907.       command_line_x_debug = TRUE;
  908.       ++i;
  909.       continue;
  910.     }
  911.  
  912.     if (strcmp(argv[i],"-boot") == 0 
  913.     || strcmp(argv[i],"-Xdebug") == 0) {
  914.       command_line_boot_file = argv[i+1];
  915.       i+=2;
  916.       continue;
  917.     }
  918.  
  919.     if (strcmp(argv[i],"-heap") == 0) {
  920.       if (argc - i < 2) {
  921.     fprintf(stderr,"eulisp: bad -heap option\n");
  922.     exit(1);
  923.       }
  924.       sscanf(argv[i+1],"%d",&command_line_heap_size);
  925.       i+=2;
  926.       continue;
  927.     }
  928.  
  929.     if (strcmp(argv[i],"-stack-space") == 0) {
  930.       if (argc - i < 2) {
  931.     fprintf(stderr,"eulisp: bad -stack-space option\n");
  932.     exit(1);
  933.       }
  934.       sscanf(argv[i+1],"%d",&command_line_stack_space_size);
  935.       i+=2;
  936.       continue;
  937.     }
  938.  
  939.     if (strcmp(argv[i],"-procs") == 0) {
  940.       if (argc - i < 2) {
  941.     fprintf(stderr,"eulisp: bad -procs option\n");
  942.     exit(1);
  943.       }
  944.       sscanf(argv[i+1],"%d",&command_line_processors);
  945.       if (command_line_processors < 1) {
  946.     fprintf(stderr,"eulisp: bad -procs value\n");
  947.     exit(1);
  948.       }
  949.       if (command_line_processors > MAX_PROCESSORS) {
  950.     fprintf(stderr,"eulisp: -procs value higher than %d maximum\n",
  951.         MAX_PROCESSORS);
  952.     exit(1);
  953.       }
  954.       i+=2;
  955.       continue;
  956.     }
  957.  
  958.     if (strcmp(argv[i],"-map") == 0) {
  959.       command_line_map_flag = TRUE;
  960.       ++i;
  961.       continue;
  962.     }
  963.  
  964.     if (strcmp(argv[i],"-gen-interfaces") == 0) {
  965.       command_line_interface_flag = TRUE;
  966.       ++i;
  967.       continue;
  968.     }
  969.  
  970.     fprintf(stderr,"eulisp: unknown option '%s'\n",argv[i]);
  971.     exit(1);
  972.  
  973.   }
  974.  
  975.   /* From environment */
  976. }
  977.  
  978. #ifdef KJP
  979.  
  980. /*
  981.  ** Hacked histories...
  982.  **
  983.  **   One to redo commands and one for values.
  984.  */
  985.  
  986. typedef struct history_structure {
  987.   LispObject value_list;
  988.   int        count;
  989. } History;
  990.  
  991. /* Abstract operations */
  992.  
  993. static void initialise_history(History *h)
  994. {
  995.   h->value_list = nil;
  996.   h->count = 0;
  997. }
  998.  
  999. static void add_history_value(History *h,LispObject value)
  1000. {
  1001.   extern LispObject Fn_nconc(LispObject*);
  1002.  
  1003.   ++(h->count);
  1004.   EUCALLSET_2(value, Fn_cons, value, nil);
  1005.   EUCALLSET_2(h->value_list, Fn_nconc, h->value_list,value);
  1006. }
  1007.  
  1008. static LispObject get_history_value(History *h,int n)
  1009. {
  1010.   LispObject walker;
  1011.   int i;
  1012.  
  1013.   if (n > h->count) return(NULL);
  1014.  
  1015.   for (walker = h->value_list, i = 0; i < n; ++i, walker = CDR(walker));
  1016.  
  1017.   return(CAR(walker));
  1018. }
  1019.  
  1020. static void show_history(History *h)
  1021. {
  1022.   int i;
  1023.   LispObject walker;
  1024.  
  1025.   EUDECL(Gf_generic_write);
  1026.  
  1027.   for (i = 0, walker = h->value_list;
  1028.          is_cons(walker); 
  1029.            ++i, walker = CDR(walker)) {
  1030.  
  1031.     printf("%d: ",i);
  1032.     (void) EUCALL_2(Gf_generic_write,CAR(walker),StdOut);
  1033.     printf("\n");
  1034.     fflush(stdout);
  1035.  
  1036.   }
  1037.  
  1038. }
  1039.  
  1040. /* Our histories... */
  1041.  
  1042. /* Input history */
  1043.  
  1044. static SYSTEM_GLOBAL(History *,input_history);
  1045.  
  1046. /* Value history */
  1047.  
  1048. static SYSTEM_GLOBAL(History *,value_history);
  1049.  
  1050. static int history_index(History *h,LispObject sym,char *prefix)
  1051. {
  1052.   int len,index,i;
  1053.  
  1054.   len = strlen(prefix);
  1055.  
  1056.   /* Too short or not right? */
  1057.  
  1058.   if (strlen(stringof(sym->SYMBOL.pname)) < len) return(-1);
  1059.   if (strncmp(stringof(sym->SYMBOL.pname),prefix,len) != 0) return(-1);
  1060.  
  1061.   /* Exactly right? */
  1062.  
  1063.   if (strlen(stringof(sym->SYMBOL.pname)) == len) return(h->count-1);
  1064.  
  1065.   /* All digits */
  1066.  
  1067.   for (i = len; stringof(sym->SYMBOL.pname)[i] != '\0'; ++i)
  1068.     if (!isdigit(stringof(sym->SYMBOL.pname)[i])) return(-1);
  1069.  
  1070.   /* Get the number */
  1071.  
  1072.   sscanf(&(stringof(sym->SYMBOL.pname)[len]),"%d",&index);
  1073.  
  1074.   /* OK? */
  1075.  
  1076.   if (index >= h->count || index < 0) return(-1);
  1077.  
  1078.   return(index);
  1079.  
  1080. }
  1081.  
  1082. void add_input_history_value(LispObject form)
  1083. {
  1084.   add_history_value(SYSTEM_GLOBAL_VALUE(input_history),form);
  1085. }
  1086.  
  1087. LispObject input_history_replace(LispObject sym)
  1088. {
  1089.   int index;
  1090.  
  1091.   index = history_index(SYSTEM_GLOBAL_VALUE(input_history),sym,"!");
  1092.  
  1093.   if (index < 0) return(sym);
  1094.  
  1095.   return(get_history_value(SYSTEM_GLOBAL_VALUE(input_history),index));
  1096. }
  1097.   
  1098. void add_value_history_value(LispObject form)
  1099. {
  1100.   add_history_value(SYSTEM_GLOBAL_VALUE(value_history),form);
  1101. }
  1102.  
  1103. LispObject value_history_replace(LispObject sym)
  1104. {
  1105.   int index;
  1106.  
  1107.   index = history_index(SYSTEM_GLOBAL_VALUE(value_history),sym,"!!");
  1108.  
  1109.   if (index < 0) return(sym);
  1110.  
  1111.   return(get_history_value(SYSTEM_GLOBAL_VALUE(value_history),index));
  1112. }
  1113.  
  1114. LispObject replace_with_history_value(LispObject sym)
  1115. {
  1116.   return(value_history_replace(input_history_replace(sym)));
  1117. }
  1118.  
  1119. static void initialise_histories()
  1120. {
  1121.   SYSTEM_INITIALISE_GLOBAL(History *,input_history,
  1122.                (History *) system_static_malloc(sizeof(History)));
  1123.   SYSTEM_INITIALISE_GLOBAL(History *,value_history,
  1124.                (History *) system_static_malloc(sizeof(History)));
  1125.  
  1126.   initialise_history(SYSTEM_GLOBAL_VALUE(input_history));
  1127.   initialise_history(SYSTEM_GLOBAL_VALUE(value_history));
  1128.  
  1129. }
  1130.  
  1131. int get_history_count()
  1132. {
  1133.   return(SYSTEM_GLOBAL_VALUE(input_history)->count);
  1134. }
  1135.  
  1136. #else /* KJP */
  1137.  
  1138. /* Old hacked histories */
  1139.  
  1140. static SYSTEM_GLOBAL(LispObject,history_list);
  1141. static SYSTEM_GLOBAL(int,history_list_length);
  1142. static SYSTEM_GLOBAL(int,history_count);
  1143.  
  1144. int get_history_count()
  1145. {
  1146.   return(SYSTEM_GLOBAL_VALUE(history_count));
  1147. }
  1148.  
  1149. LispObject get_history_form(LispObject obj)
  1150. {
  1151.   LispObject walker;
  1152.   int i,n,pos;
  1153.  
  1154.   if (!is_symbol(obj)) return(obj);
  1155.   if (stringof(obj->SYMBOL.pname)[0] != '!') return(obj);
  1156.  
  1157.   i = 1;
  1158.   while(stringof(obj->SYMBOL.pname)[i] != '\0') {
  1159.     if (!isdigit(stringof(obj->SYMBOL.pname)[i])) return(obj);
  1160.     ++i;
  1161.   }
  1162.  
  1163.   sscanf(&(stringof(obj->SYMBOL.pname)[1]),"%d",&n);
  1164.  
  1165.   if (n > SYSTEM_GLOBAL_VALUE(history_count)) return(nil);
  1166.  
  1167.   pos = SYSTEM_GLOBAL_VALUE(history_list_length) - n - 1;
  1168.  
  1169.   for (walker = SYSTEM_GLOBAL_VALUE(history_list),i = 0; 
  1170.        i < pos;
  1171.        ++i, walker = CDR(walker));
  1172.  
  1173.   return(CAR(walker));
  1174. }
  1175.  
  1176. void put_history_form(LispObject *stacktop, LispObject form)
  1177. {
  1178.   ++SYSTEM_GLOBAL_VALUE(history_count);
  1179.   ++SYSTEM_GLOBAL_VALUE(history_list_length);
  1180.   EUCALLSET_2(SYSTEM_GLOBAL_VALUE(history_list), Fn_cons,
  1181.           form,SYSTEM_GLOBAL_VALUE(history_list));
  1182. }
  1183.  
  1184. void start_history()
  1185. {
  1186.   SYSTEM_INITIALISE_GLOBAL(LispObject,history_list,nil);
  1187.   SYSTEM_INITIALISE_GLOBAL(int,history_list_length,0);
  1188.   SYSTEM_INITIALISE_GLOBAL(int,history_count,0);
  1189.  
  1190.   ADD_SYSTEM_GLOBAL_ROOT(history_list);
  1191. }
  1192.  
  1193. #endif /* KJP */
  1194.  
  1195. #ifdef KJP
  1196.  
  1197. /*
  1198.  ** Noddy input processing 
  1199.  */
  1200.  
  1201. static LispObject sym_pling_root;
  1202. static LispObject sym_pling_exit;
  1203. static LispObject sym_pling_b;
  1204. static LispObject sym_pling_backtrace;
  1205. static LispObject sym_pling_q;
  1206. static LispObject sym_pling_quickie;
  1207. static LispObject sym_pling_c;
  1208. static LispObject sym_pling_commands;
  1209. static LispObject sym_pling_v;
  1210. static LispObject sym_pling_values;
  1211.  
  1212. LispObject process_input_form(LispObject form)
  1213. {
  1214.   
  1215.   add_input_history_value(form);
  1216.  
  1217.   /* We only know about magic symbols */
  1218.  
  1219.   if (!is_symbol(form)) return(form);
  1220.  
  1221.   /* Special symbols... */
  1222.  
  1223.   /* !root */
  1224.  
  1225.   if (form == sym_pling_root) {
  1226.     SYSTEM_GLOBAL_VALUE(current_interactive_module) =
  1227.       get_module(stacktop,sym_root);
  1228.     return(nil);
  1229.   }
  1230.  
  1231.   /* EOF or !exit */
  1232.  
  1233.   if (form == q_eof || form == sym_pling_exit) return(NULL);
  1234.  
  1235.   /* !b or !backtrace */
  1236.  
  1237.   if (form == sym_pling_b || form == sym_pling_backtrace) {
  1238.  
  1239.     module_eval_backtrace();
  1240.     return(nil);
  1241.  
  1242.   }
  1243.  
  1244.   /* !q or !quickie */
  1245.  
  1246.   if (form == sym_pling_q || form == sym_pling_quickie) {
  1247.  
  1248.     quickie_module_eval_backtrace();
  1249.     return(nil);
  1250.  
  1251.   }
  1252.  
  1253.   /* !c or !commands */
  1254.  
  1255.   if (form == sym_pling_c || form == sym_pling_commands) {
  1256.  
  1257.     show_history(SYSTEM_GLOBAL_VALUE(input_history));
  1258.     return(nil);
  1259.  
  1260.   }
  1261.  
  1262.   /* !v or !values */
  1263.  
  1264.   if (form == sym_pling_v || form == sym_pling_values) {
  1265.  
  1266.     show_history(SYSTEM_GLOBAL_VALUE(value_history));
  1267.     return(nil);
  1268.  
  1269.   }
  1270.  
  1271.   /* We know nothing! */
  1272.  
  1273.   return(form);
  1274.  
  1275. }
  1276.  
  1277. LispObject process_result_form(LispObject form)
  1278. {
  1279.   add_value_history_value(form);
  1280.   return(form);
  1281. }
  1282.  
  1283. void initialise_input_processing()
  1284. {
  1285.   initialise_histories();
  1286.  
  1287.   sym_pling_root = get_symbol(stacktop,"!root");
  1288.   sym_pling_exit = get_symbol(stacktop,"!exit");
  1289.   sym_pling_b = get_symbol(stacktop,"!b");
  1290.   sym_pling_backtrace = get_symbol(stacktop,"!backtrace");
  1291.   sym_pling_q = get_symbol(stacktop,"!q");
  1292.   sym_pling_quickie = get_symbol(stacktop,"!quickie");
  1293.   sym_pling_c = get_symbol(stacktop,"!c");
  1294.   sym_pling_commands = get_symbol(stacktop,"!commands");
  1295.   sym_pling_v = get_symbol(stacktop,"!v");
  1296.   sym_pling_values = get_symbol(stacktop,"!values");
  1297. }
  1298.  
  1299. #endif /* KJP */
  1300.  
  1301.  
  1302.